perm filename RREAD.F4[1,LCS] blob
sn#573310 filedate 1981-03-12 generic text, type T, neo UTF8
00200 DIMENSION KNT(72),RI(72),I(72)
00500 1 FORMAT(72A1)
00600 2 FORMAT(' TYPE '$)
00700 4 FORMAT(20I3)
00800 200 FORMAT(1XA1/)
00900 201 FORMAT(F13.4/)
01000 100 WRITE(5,2)
01100 READ(5,1)I
01200 CALL ASCINT(I,RI,KNT,M)
04200 WRITE(5,4)(KNT(J),J=1,M)
04250 KK=-1
04300 DO 11 K=1,M
04400 IF(KNT(K).NE.0)GO TO 111
04450 WRITE(5,200)RI(K)
04475 IF(KK.LT.0)KK=K
04487 GO TO 11
04500 111 IF(KK.GT.0)CALL PAKIT(KK,K,RI)
04550 KK=-1
04575 WRITE(5,201)RI(K)
04587 11 CONTINUE
04590 IF(KK.GT.0)CALL PAKIT(KK,K,RI)
04600 GO TO 100
04700 END
04800
04900 SUBROUTINE PAKIT(KK,K,LET)
05000 DIMENSION LT(5),LET(1)
05100 J=K-KK
05200 2 JJ=J
05300 IF(JJ.GT.5)JJ=5
05310 DO 3 N=1,5
05320 3 LT(N)=' '
05325 NN=KK
05330 DO 4 N=1,5
05340 IF(LET(NN).EQ.' '.OR.LET(NN).GT.0)GO TO 5
05350 LT(N)=LET(NN)
05360 4 NN=NN+1
05400 5 CALL PACKX(JWD,LT)
05500 TYPE 1,JWD
05600 IF(JJ.EQ.J)RETURN
05700 1 FORMAT(1XA5/)
05800 J=J-JJ
05900 KK=KK+5
06000 GO TO 2
06100 END
18400 SUBROUTINE PACKX(NAM,KNM)
18500 DIMENSION KNM(5)
18600 DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
18700 1 , MM/"774000000000/
18800 NAM=0
18900 DO 12 K=5,1,-1
19000 NAM=NAM .OR. (KNM(K) .AND. MM)
19100 IF (K.EQ.1)RETURN
19200 17 IF (NAM.GE.0)GO TO 13
19300 NAM = (( NAM .AND. LL)/KK) .OR. JJ
19400 GO TO 12
19500 13 NAM = NAM / KK
19600 12 CONTINUE
19700 RETURN
19800 END